! ---
! Copyright (C) 1996-2016	The SIESTA group
!  This file is distributed under the terms of the
!  GNU General Public License: see COPYING in the top directory
!  or http://www.gnu.org/copyleft/gpl.txt .
! See Docs/Contributors.txt for a list of contributors.
! ---
! pxf.F90 - assortment of Fortran wrappers to various
! unix-y system calls.
!
! Copyright Toby White, <tow21@cam.ac.uk> 2005

! The name pxf is intended to be reminiscent of the POSIX
! fortran interfaces defined by IEEE 1003.9-1992, although
! in fact I don't think that either flush or abort were
! covered by said standard.

! Of the preprocessor defines used here, only xlF is
! automatically defined by the appropriate compiler. All
! others must be defined by some other mechanism - I
! recommend autoconf.

  
! FLUSH: flushes buffered output on a given unit. Not guaranteed
! to do anything at all (particularly under MPI when even FLUSHed 
! buffers may not make it to the host cpu after an abort.
!
! IMPLEMENTATION: in F2003, this is a native operation called by the
! FLUSH statement.
! In almost every compiler, there is a FLUSH intrinsic subroutine 
! available which takes one argument, the unit to be flushed.
! (some will flush all open units when no argument is given - this 
!  facility is not used here.
! NAG complicates matters by having to USE a module to get at flush.
! 
! If no FLUSH is available, the subroutine is a no-op.

!! UPDATE: We assume F2003
#ifndef SIESTA__NO_F2003
      subroutine pxfflush(unit)
        implicit none
        integer, intent(in) :: unit
        flush(unit)
      end subroutine pxfflush
#else
      subroutine pxfflush(unit)
#ifdef __NAG__
      use f90_unix_io, only : flush
#endif
      implicit none
      integer, intent(in) :: unit
#if defined(F2003)
      flush(unit)
#elif defined(GFORTRAN)
      call flush(unit)
#elif defined(__GFORTRAN__)
      call flush(unit)
#elif defined(XLF)
      if (unit.eq.6 .or. unit.eq.0) then
        call flush_(unit)
      else
        flush(unit)
      endif
#elif defined (FC_HAVE_FLUSH)
      call flush(unit)
#elif defined (ALTIX)
      flush(unit)
      call flush(unit)
#else
      continue
#endif
      end subroutine pxfflush
#endif
      
! ABORT: terminates program execution in such a way that a backtrace
! is produced. (see abort() in the C Standard Library). No arguments.
!
! IMPLEMENTATION: In F2003, the C interoperability features mean that
! the abort in stdlib.h is available to be linked against.
! In several other compilers an ABORT intrinsic subroutine is available.
! Again, NAG complicates matters by needing to USE a module.
!
! In the case where no native ABORT can be found, we emulate one
! by dereferencing a null pointer. This has reliably produced coredumps
! on every platform I've tried it with. Just in case it doesn't (it need
! not even stop execution) a stop is given to force termination.

!! UPDATE: We assume F2003
#ifndef SIESTA_NO_F2003      
      subroutine pxfabort()
      interface
        subroutine abort() bind(c)
        end subroutine abort
      end interface
      call abort()
      end subroutine pxfabort

#else
      
      subroutine pxfabort()
#ifdef __NAG__
      use f90_unix_proc, only : abort
#endif

#ifdef F2003
      interface
        subroutine abort() bind(c)
        end subroutine abort
      end interface
      call abort()
#elif defined(GFORTRAN)
      call abort()
#elif defined(__GFORTRAN__)
  call abort()
#elif defined(XLF)
      call abort_()
#elif defined(FC_HAVE_ABORT)
      call abort()
#elif defined(ALTIX)
      call abort()
#else
      Integer, Pointer :: i
      i=>null()
      Print*,i
#endif

      stop

      end subroutine pxfabort
#endif

